perm filename FONTS.SAI[PUB,TES]1 blob
sn#129318 filedate 1974-11-07 generic text, type T, neo UTF8
00100 BEGOF("FONTS")
00200
00300 IFC PASSONE THENC
00400
00500 COMMENT
00600
00700 *** Variations at Different Sites ***
00800
00900 Font file formats differ at each site. Default device parameters
01000 (mostly specified in PUBDFS.SAI and COMDFS.SAI, but partly in
01100 SETDEVICEPARAMETERS) also differ. Character width checking is only
01200 enabled at some sites (XLENGTH).
01300
01400 ***
01500
01600 This module handles device characteristics, fonts, pichars, and
01700 raster measurements. Some of it is shared by passes one and two, but
01800 most of it is for pass one only.
01900
02000 The trickiest thing is the font numbering system. There are three
02100 numbering systems: the one in the FONT declaration (one character 0-9
02200 A-F), the one used to index arrays (0-16), and the one expected by
02300 the device (varies). Yechh!
02400
02500 ;
02600
02700 ENDC
02740
02742 IFCR PARCVER THENC
02744 DEFINE MAXNEQUIVS = [100] ;
02748 INTEGER NEQUIVS ;
02784 OWN STRING ARRAY EQUIV[1:MAXNEQUIVS, 2:4] ;
02788 ENDC
02800
02900 PROCEDURES
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE FONTS! ;$"#
00300 BEGIN "FONTS!"
00500 WCW ← WHATIS(CW) ; COMMENT original font ;
00600 THISFONT ← OLDFONT ← DEFAULTFONT ;
00700 FSFONT ← DEFAULTFONT ; TES 11/29/73 ;
00800 LOFONT ← 99 ; HIFONT ← 0 ; TES 8/24/74 ;
00900 ODDLEFTBORDER ← ODDLEFTBORDERDEFAULT ; EVENLEFTBORDER ← EVENLEFTBORDERDEFAULT ; TES 8/21/74 ;
01000 SETDEVICEPARAMETERS(ABS(DEVICE)) ; TES 8/24/74 ;
01100 END "FONTS!" ;
01200 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE DDEVICE ;$"#
00300 BEGIN PASS ;
00400 RKJ: 19-AUG-74 ADDED ON BELOW;
00500 IF DEVICE GEQ 0 AND ON THEN COMMENT IF <0, WAS SET BY /SWITCH, WHICH TAKES PRECEDENCE ;
00600 BEGIN
00650 IFCR PARCVER THENC PARCMIC ENDC
00700 IF ITS(MIC) THEN DEVICE←MIC
00800 ELSE IF ITS(TTY) THEN DEVICE←TTY
00900 ELSE IF ITS(LPT) THEN DEVICE←LPT
01000 ELSE IF ITS(XGP) THEN DEVICE←XGP
01100 ELSE BEGIN WARN("=","No such device: "&THISWD) ; PASS ; RETURN END ;
01200 SETDEVICEPARAMETERS(ABS(DEVICE)) ; TES 8/24/74 ;
01300 END ;
01400 PASS ;
01500 END "DDEVICE" ;
01600 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE DFONT(BOOLEAN SELECT) ;$"#
00300 BEGIN "DFONT"
00400 INTEGER F;
00500 PASS;
00502 IFC PARCVER THENC
00505 IF ITS(EQUIVALENCE) THEN TES 10/21/74 ;
00520 WHILE TRUE DO
00525 BEGIN
00530 IF NEQUIVS<MAXNEQUIVS THEN NEQUIVS←NEQUIVS+1
00535 ELSE WARN(NULL,"Exceeded limit of " & CVS(MAXNEQUIVS) & " FONT EQUIVALENCEs") ;
00540 FOR F ← 2, XGP, MIC DO
00545 BEGIN
00547 PASS ;
00550 EQUIV[NEQUIVS,F] ← E(NULL, NULL) ;
00560 IF NOT ITSCH(<,>) THEN DONE ;
00565 END ;
00570 IF NOT ITSCH(<,>) THEN RETURN ;
00575 END ;
00580 ENDC
00600 IF LENGTH(THISWD)=1 AND THISTYPE GEQ 0 AND (F←RFONT(THISWD)) GEQ 0 THEN PASS
00700 ELSE F ← RFONT(E(NULL,NULL)) ; TES 11/29/73 ;
00800 IF F<0 THEN
00900 BEGIN WARN("=",<"Illegal font '"&F&"'">); RETURN END;
01000 IF SELECT THEN SELECTFONT(F) TES 1/22/74 ADDED OPTIONAL XGP FILENAME ;
01100 ELSE READFONT(F,E(NULL,NULL), IF ITSCH(<,>) THEN PASS&E(NULL,NULL) ELSE NULL);
01200 END "DFONT";
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE DPICHAR ;$"#
00300 BEGIN TES 11/29/73 ;
00400 INTEGER KEY, IX, F, N ; STRING S ;
00500 INPICHAR ← TRUE ;
00550 S ← NULL ;
00600 PASS ;
00700 KEY ←E(NULL,NULL) ;
00800 IF ITSCH(<(>) THEN
00900 BEGIN COMMENT TURN ON ;
01000 PASS ;
01100 DO S ← S & E(NULL,NULL) UNTIL ITSCH(<)>) ;
01200 PASS ;
01300 IF ITS(WIDTH) THEN
01400 BEGIN PASS ;
01500 IF ITS(OF) THEN BEGIN PASS ; F←'177; N←CVD(E(NULL,NULL)) END
01600 ELSE BEGIN F←CVD(E(NULL,NULL)); N←F MOD '177; F←F DIV '177 END
01700 END
01800 ELSE BEGIN F←'177 ; N ← SP END ;
01900 S ← F & N & S ;
02000 END
02100 ELSE S ← NULL ; COMMENT TURN OFF ;
02200 IX ← PUSHI(PIWDS,PITYPE) ;
02300 PIKEY(IX) ← KEY ; PIVAL(IX) ← PUSHS(1, PICHAR[KEY]) ;
02400 PICHAR[KEY] ← S ;
02500 INPICHAR ← FALSE ;
02600 END "DPICHAR" ;
02700 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE STRING PROCEDURE FONTEQUIV(STRING ABBREV) ;$"#
00300 BEGIN "FONTEQUIV" TES 10/21/74 CALLED BY OPENTOREAD ;
00400 IFCR PARCVER THENC
00500 INTEGER I, D ; STRING ALTNAME ;
00600 IF ABS(DEVICE) LEQ 2 THEN RETURN(NULL) ;
00650 ABBREV ← CAPITALIZE(ABBREV) ;
00700 FOR D ← 2, XGP+MIC-ABS(DEVICE) DO
00800 FOR I ← NEQUIVS STEP -1 UNTIL 1 DO
00900 IF EQU(EQUIV[I,D], ABBREV) THEN
01000 BEGIN
01100 ALTNAME ← EQUIV[I, ABS(DEVICE)] ;
01200 IF NULSTR(ALTNAME) THEN CONTINUE ;
01300 IF ALTNAME = "*" THEN
01400 BEGIN
01500 LOPP(ALTNAME) ;
01600 IF NOT SWDBACK THEN OUTSTR(CRLF) ; SWDBACK ← TRUE ;
01700 OUTSTR("Closest FONT to " & ABBREV & " is " & ALTNAME & CRLF) ;
01800 END ;
01900 IF EQU(ALTNAME, ABBREV) THEN CONTINUE ;
02000 RETURN(ALTNAME) ;
02100 END ;
02200 RETURN(NULL) ;
02300 ENDC
02400 END "FONTEQUIV" ;
02500 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE STRING PROCEDURE MASH(STRING S) ;$"#
00300 BEGIN COMMENT TES 8/14/74 UNPACK 7-BIT BYES TO 64-EXCESS 4-BIT BYTES;
00400 INTEGER C ; STRING Q ;
00500 Q ← NULL ;
00600 WHILE FULSTR(S) DO
00700 BEGIN
00800 C ← LOP(S) ;
00900 Q ← Q & ((C LSH -4)+64) & ((C LAND '17)+64) ;
01000 END ;
01100 RETURN(Q) ;
01200 END ;
01300 ENDC
00100 IFK PASSONE OR PASSTWO THENK
00200 PUBLIC SIMPLE INTEGER PROCEDURE PERUSEFONT(INTEGER WHICH, CHAN) ;$"#
00300 BEGIN
00400 INTEGER I, K, FSIZE ;
00500 IFCR ITSVER THENC PJ 5/28/74 ;
00600 WORDIN(CHAN);
00700 FNTINF[WHICH]←WORDIN(CHAN);
00800 IF WHICH=DEFAULTFONT THEN BASELINE←LDB(POINT(9,FNTINF[WHICH],17));
00900 FNTINF[WHICH]←LDB(POINT(18,FNTINF[WHICH],35)); comment HEIGHT;
01000 WHILE NOT EOF DO
01100 IF (WORDIN(CHAN) LAND 1) THEN
01200 BEGIN
01300 DUMMY←LDB(POINT(18,DUMMY←WORDIN(CHAN),35));
01400 CW[DUMMY]←LDB(POINT(18,CW[DUMMY]←WORDIN(CHAN),35));
01500 END
01600 ENDC
01700 IFCR CMUXGP THENC RKJ: MODIFIED 7-nov-74;
01750 WORDIN(CHAN); COMMENT KST ID;
01800 FNTINF[WHICH]←WORDIN(CHAN); COMMENT RKJ 10-10-73;
01850 IF (DUMMY←WORDIN(CHAN)) NEQ 2 THEN
01900 BEGIN "FORMAT 1"
01950 LABEL whattakludge;
02000 IF DUMMY LAND 1 THEN GO whattakludge;
02050 WHILE NOT EOF DO
02100 IF (WORDIN(CHAN) LAND 1) THEN
02150 whattakludge: BEGIN DUMMY←WORDIN(CHAN); CW[DUMMY]←WORDIN(CHAN) END
02200 END "FORMAT 1"
02250 ELSE
02300 BEGIN "FORMAT 2"
02350 IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN) ELSE WORDIN(CHAN);
02400 ARRYIN(CHAN,CW[0],6); COMMENT UNUSED WORDS;
02450 ARRYIN(CHAN,CW[0],128); COMMENT XWD INCR,WIDTH;
02500 FOR I←0 THRU 127 DO CW[I]←CW[I] LSH -18;
02550 END "FORMAT 2";
02600 ENDC
03400 IFCR SAILVER THENC
03500 ARRYIN(CHAN,CW[0],128);
03600 FOR I ← 0 THRU 127 DO CW[I] ← IF CW[I] THEN CW[I] LSH -18 ELSE -1 ; BH 11/5/74;
03700 WORDIN(CHAN); FNTINF[WHICH]←WORDIN(CHAN);
03800 WORDIN(CHAN);
03900 IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN);
04000 ENDC
04100 IFCR PARCVER THENC
04200 BEGIN
04300 EXTERNAL INTEGER GOGTAB;
04400 INTEGER I, K ;
04500 SFBSZ(CHAN, 16) ;
04600 IF ABS(DEVICE)=MIC THEN
04700 PARCFILE
06000 ELSE BEGIN
06100 K←WORDIN(CHAN); WORDIN(CHAN);
06200 FNTINF[WHICH]←WORDIN(CHAN); WORDIN(CHAN);
06300 FOR I←1 THRU K DO WORDIN(CHAN);
06400 K←(K MIN 128)-1;
06500 FOR I←0 THRU K DO CW[I]←WORDIN(CHAN);
06600 END ;
06700 END;
06800 ENDC;
06900 RETURN(FSIZE) ;
07000 END "PERUSEFONT" ;
07100 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE STRING PROCEDURE PICKFONT(INTEGER F) ;$"#
00300 RETURN(FONTCHAR&"F"&(IF F<10 THEN (F+"0") ELSE (F+("A"-10))));
00400 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE READFONT(INTEGER WHICH; STRING FILENAME, BFILENAME) ;$"#
00300 IF ON AND XCRIBL THEN TES 8/24/74 PROCEDURIZED AND SIMPLIFIED;
00400 BEGIN "READFONT"
00500 INTEGER SAVCW, CHAN;
00600 SAVCW ← WHATIS(CW);
00700 IF FNTFIL[WHICH] = 0 THEN FNTFIL[WHICH] ← CREATE(0,127);
00800 DUMMY ← FNTFIL[WHICH] ;
00900 IF SAVCW=WCW AND WHICH=DEFAULTFONT THEN SAVCW←DUMMY;
01000 MAKEBE(DUMMY,CW);
01100 CHAN ← OPENTOREAD('14, "Font file ", FILENAME,
01200 FONTEXT, FONTPPN) ;
01300 PERUSEFONT(WHICH, CHAN) ;
01400 IF NULSTR(BFILENAME) THEN TES Didn't specify special name for XGP driver ;
01500 IFCR TENEX THENC
01600 BEGIN STRING NAME, EXT, PPN ;
01700 NAME←CVFIL(FILENAME,EXT,PPN) ;
01800 BFILENAME ← NAME & EXT ;
01900 END ;
02000 ELSEC
02100 BFILENAME ← FILENAME ;
02200 ENDC
02300 XFNTNAME[WHICH] ← BFILENAME ;
02400 FNTNAME[WHICH] ← FILENAME ;
02500 IFCR SAILVER THENC
02600 CMDFILE ← CMDFILE & "/FONT#" & CVS(WHICH-1) & "=" & FILENAME;
02700 ENDC;
02800 IFCR ITSVER THENC PJ 6/12/74 ;
02900 CMDFILE ← CMDFILE & ";KSET "&(",,,,,,,,,,"[1 FOR WHICH-1])&FILENAME & CRLF ;
03000 ENDC
03100 HIFONT ← WHICH MAX HIFONT ; LOFONT ← WHICH MIN LOFONT ; TES 8/24/74 ;
03200 RELEASE(CHAN);
03300 MAKEBE(SAVCW,CW);
03400 END "READFONT";
03500 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE INTEGER PROCEDURE RFONT(INTEGER F) ;$"#
00300 RETURN( TES SUBROUTINIZED AND CASED 11/29/73 ;
00400 IFCR SAILXGP THENC
00500 IF "1" LEQ F LEQ "9" THEN F-"0"
00600 ELSE IF "A" LEQ F LEQ "Z" THEN F-("A"-10)
00700 ELSE IF "a" LEQ F LEQ "z" THEN F-("a"-10)
00800 ELSE -1
00900 ENDC
01000 IFCR PARCVER THENC
01100 IF ABS(DEVICE)=XGP THEN
01150 IF "1" LEQ F LEQ "9" THEN F-"0"
01175 ELSE -1
01200 ELSE IF ABS(DEVICE)=MIC THEN
01300 IF "0" LEQ F LEQ "9" THEN F-"0"
01400 ELSE IF "A" LEQ F LEQ "F" THEN F-("A"-10)
01500 ELSE IF "a" LEQ F LEQ "f" THEN F-("a"-10)
01600 ELSE -1
01700 ELSE 1
01800 ENDC
01900 IFCR CMUXGP THENC
02000 IF "A" LEQ F LEQ "B" THEN F-("A"-10)
02100 ELSE IF "a" LEQ F LEQ "b" THEN F-("a"-10)
02200 ELSE IF "1" LEQ F LEQ "2" THEN F-"0"
02300 ELSE -1
02400 ENDC
02500 ) ;
02600 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE SELECTFONT(INTEGER WHICH) ;$"#
00300 IF ON THEN
00400 BEGIN "SELECTFONT"
00500 INTEGER F;
00600 DBREAK;
00700 IF NOT XCRIBL OR LAST<4 THEN RETURN;
00800 F←(IF WHICH<10 THEN (WHICH+"0") ELSE (WHICH+("A"-10)));
00900 IF FNTFIL[WHICH]=0 THEN BEGIN WARN("=",<"Unknown font '"& F & "'">);
01000 RETURN END;
01100 SWITCHFONT(WHICH) ; TES 11/14/73 SUBROUTINIZED ;
01200 END "SELECTFONT";
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ;$"#
00300 BEGIN TES 11/15/73 TO DO IT BY AREA ;
00400 INTEGER NEWIX ;
00500 IF AREAIXM AND FONTSIX(AREAIXM) < OLDIHED THEN
00600 BEGIN TES FIRST CHANGE IN THIS BLOCK IN THIS AREA ;
00700 NEWIX ← PUSHI(FONTWDS, FONTYPE) ;
00800 AREAX(NEWIX) ← AREAIXM ;
00900 OUTERX(NEWIX) ← FONTSIX(AREAIXM) ;
01000 THISFONTX(NEWIX) ← THISFONT ;
01100 OLDFONTX(NEWIX) ← OLDFONT ;
01200 FONTSIX(AREAIXM) ← NEWIX ;
01300 END ;
01400 OLDFONT ← THISFONT;
01500 IF THISFONT NEQ WHICH THEN
01600 BEGIN
01700 THISFONT ← WHICH;
01800 WHICH ← FNTFIL[WHICH]; MAKEBE(WHICH,CW);
01900 END ;
02000 END ;
02100 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC SIMPLE PROCEDURE SETDEVICEPARAMETERS(INTEGER DEVICE) ;$"#
00300 BEGIN TES 8/24/74 ;
00350 STRING ABBREV, EQD ;
00400 DEFINE GETS = [← CASE DEVICE-1 OF];
00500 COMMENT DEVICES 1=LPT 2=TTY 3=MIC 4=XGP ;
00600 COMMENT ----- ----- ----- ----- ;
00700 CHARW GETS (1, 1, 40, 16) ;
00800 MINCHARW GETS (1, 1, 0, IFC SAILVER THENC 0 ELSEC 1 ENDC) ;
00900 XCRIBL GETS (FALSE, FALSE, TRUE, TRUE) ;
01000 VBPI GETS (6, 6, VBPIMIC, VBPIXGP) ;
01100 HBPI GETS (10, 10, HBPIMIC, HBPIXGP) ;
01200 MINLFTMAR GETS (0, 0, MICMINLFTMAR, XGPMINLFTMAR) ;
01300 VUNDERLINE GETS (BAR,
01400 IFC PARCVER THENC NULL ELSEC BAR ENDC,
01500 BAR, BAR) ;
01600 IFC CMUVER THENC
01700 IF XCRIBL AND NULSTR(FNTNAME[1]) THEN
01800 BEGIN
02000 READFONT(DEFAULTFONT,"NGR25.KST[A730KS00]",NULL);
02100 END ;
02200 ENDC
02300 END "SETDEVICEPARAMETERS" ;
02400 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC STRING SIMPLE PROCEDURE TRUNCATE(STRING STR; INTEGER LEN) ;$"#
00300 BEGIN "TRUNCATE" COMMENT RETURN INITIAL SUBSTRING OF STR OF XLEN LEQ LEN ;
00400 STRING S; INTEGER I,L;
00500 S←STR; I←L←0;
00600 WHILE FULSTR(S) DO
00700 BEGIN
00800 IF (L←L+CW[LOP(S)])>LEN THEN RETURN(STR[1 TO I]);
00900 I←I+1;
01000 END;
01100 RETURN(STR);
01200 END "TRUNCATE";
01300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE XLENGTH(STRING CHARS) ;$"#
00300 BEGIN "XL"
00400 INTEGER COUNT,CH,W,MAXCHARW;
00500 IF NOT XCRIBL THEN RETURN(0); COMMENT IF NOT IN XCRIBL MODE THEN WE DON'T NEED THIS VALUE;
00550 IF NOT ON THEN RETURN(0) ; TES 10/20/74 ;
00600 COUNT←0; MAXCHARW←XMAXIM; TES 8/24/74 ;
00700 WHILE FULSTR(CHARS) DO
00800 IFCR SAILVER OR PARCVER THENC
00900 BEGIN TES 8/14/74, HOW ABOUT CMU & ITS ? ;
01000 IF MINCHARW LEQ (W← CW[ CH←LOP(CHARS) ]) LEQ MAXCHARW THEN
01100 COUNT ← COUNT + W
01200 ELSE WARN("Bad FONT char", <"The character '" & CVOS(CH) &
01300 " has an unusual FONT width " & CVS(W) &
01400 (IF NULSTR(FNTNAME[THISFONT]) THEN CRLF & "because you forgot to declare FONT "
01500 ELSE " in " & FNTNAME[THISFONT] & " FONT ") &
01600 PICKFONT(THISFONT)[3 TO 3]>) ;
01700 END ;
01800 ELSEC
01900 COUNT ← COUNT + CW[LOP(CHARS)];
02000 ENDC
02100 RETURN (COUNT);
02200 END;
02300 ENDC
00100 IFK PASSONE THENK
00200 PUBLIC INTEGER SIMPLE PROCEDURE XSPLEN(INTEGER N) ;$"#
00300 RETURN(N * CW[SP]);
00400 ENDC
00100 IFK PASSONE THENK
00200
00300 FINISHED
00400
00500 ENDOF("FONTS")
00600
00700 ENDC